//*************************************************************
//                          EwbCore                           *
//                                                            *
//                     Freeware Component                     *
//                       For Delphi                           *
//                            by                              *
//                     Per Lindso Larsen                      *
//      Developing Team:                                      *
//          Eran Bodankin (bsalsa) -(bsalsa@bsalsa.com)       *
//          Serge Voloshenyuk SergeV@bsalsa.com)              *
//          Mathias Walter (mich@matze.tv)                    *
//                                                            *
//       Documentation and updated versions:                  *
//                                                            *
//               http://www.bsalsa.com                        *
//*************************************************************
{LICENSE:
THIS SOFTWARE IS PROVIDED TO YOU "AS IS" WITHOUT WARRANTY OF ANY KIND,
EITHER EXPRESSED OR IMPLIED INCLUDING BUT NOT LIMITED TO THE APPLIED
WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
YOU ASSUME THE ENTIRE RISK AS TO THE ACCURACY AND THE USE OF THE SOFTWARE
AND ALL OTHER RISK ARISING OUT OF THE USE OR PERFORMANCE OF THIS SOFTWARE
AND DOCUMENTATION. [YOUR NAME] DOES NOT WARRANT THAT THE SOFTWARE IS ERROR-FREE
OR WILL OPERATE WITHOUT INTERRUPTION. THE SOFTWARE IS NOT DESIGNED, INTENDED
OR LICENSED FOR USE IN HAZARDOUS ENVIRONMENTS REQUIRING FAIL-SAFE CONTROLS,
INCLUDING WITHOUT LIMITATION, THE DESIGN, CONSTRUCTION, MAINTENANCE OR
OPERATION OF NUCLEAR FACILITIES, AIRCRAFT NAVIGATION OR COMMUNICATION SYSTEMS,
AIR TRAFFIC CONTROL, AND LIFE SUPPORT OR WEAPONS SYSTEMS. VSOFT SPECIFICALLY
DISCLAIMS ANY EXPRESS OR IMPLIED WARRANTY OF FITNESS FOR SUCH PURPOSE.

You may use/ change/ modify the component under 4 conditions:
1. In your website, add a link to "http://www.bsalsa.com"
2. In your application, add credits to "Embedded Web Browser"
3. Mail me  (bsalsa@bsalsa.com) any code change in the unit  for the benefit
   of the other users.
4. Please, consider donation in our web site!
{*******************************************************************************}


unit EwbCore;

interface
{$I EWB.inc}
//IOLECOMMANDTARGET-------------------------------------------------------------
{To remove the IOLECOMMANDTARGET, just add a dot like "{.$DEFINE...USE_IOLECOMMANDTARGET" or something.
and re-compile the package.}
{$DEFINE USE_IOLECOMMANDTARGET}
//------------------------------------------------------------------------------
{ $DEFINE OLDVERSION_COMPATIBLE}

uses
{$IFDEF DELPHI_6_UP}Variants, {$ENDIF}
   Dialogs, Windows, Messages, Classes, Mshtml_Ewb, EWBAcc, Graphics, Controls, Forms,
   ExtCtrls, ActiveX, ShlObj, SHDocVw_EWB, UrlMon, IEConst;

type
   TCustomEmbeddedWB = class;

   TOleCmdArray = array of TOleCmd;
   TDragDropHandlingType = (
      ddtMS, // Microsoft implementation
      ddtMy, // TCustomEmbeddedWB event handlers
      ddtCustom, // granted by user in OnGetDropTarget event handler
      ddtNo // no drag and drop
      );
   TDocDesignMode = (ddmOn, ddmOff, ddmInherit, ddmUnknown);

   TIEPopupMenu = (
      rcmDefault,
      rcmImage,
      rcmControl,
      rcmTable,
      rcmSelText,
      rcmAnchor,
      rcmUnKnown,
      rcmImageArt,
      rcmImgDynSrc,
      rcmDebug,
      rcmAll
      );
   TIEPopupMenus = set of TIEPopupMenu;

   TIEPopupMenuItem = (
      rcsBack,
      rcsForward,
      rcsSavePageBkg,
      rcsSetAsBkg,
      rcsCopyBkg,
      rcsSetAsDeskT,
      rcsSelectAll,
      rcsPaste,
      rcsCreateSC,
      rcsAddToFav,
      rcsEncoding,
      rcsRefresh,
      rcsViewSource,
      rcsProperties,
      rcsPrint,
      rcsOpenNWindow,
      rcsOpenLink
      );
   TIEPopupMenuItems = set of TIEPopupMenuItem;

   {============================================================================}
   {Controlling Download and Execution}
   {http://msdn.microsoft.com/library/default.asp?url=/workshop/browser/hosting/wbcustomization.asp}
   { TDownloadControlOption = (
        DLCTL_DLIMAGES, DLCTL_VIDEOS, DLCTL_BGSOUNDS, DLCTL_NO_SCRIPTS,
        DLCTL_NO_JAVA, DLCTL_NO_RUNACTIVEXCTLS, DLCTL_NO_DLACTIVEXCTLS,
        DLCTL_DOWNLOADONLY, DLCTL_NO_FRAMEDOWNLOAD, DLCTL_RESYNCHRONIZE,
        DLCTL_PRAGMA_NO_CACHE, DLCTL_NO_BEHAVIORS, DLCTL_NO_METACHARSET,
        DLCTL_URL_ENCODING_DISABLE_UTF8, DLCTL_URL_ENCODING_ENABLE_UTF8,
        DLCTL_FORCEOFFLINE, DLCTL_NO_CLIENTPULL, DLCTL_SILENT, DLCTL_OFFLINE); }
   TDownloadControlOption = (
      DownloadImages, DownloadVideos, DownloadBGSounds, DontExecuteScripts,
      DontExecuteJava, DontExecuteActiveX, DontDownloadActiveX,
      DownloadButDontDisplay, DontDownloadFrame, CheckPageResynchronize,
      DownloadAndIgnoreCache, DontDownloadBehaviors, SuppressedMetaCharset,
      DisableUrlIfEncodingUTF8, EnableUrlIfEncodingUTF8,
      ForceOfflineMode, DontPerformClientPull, DonloadInSilentMode, WorkOffline);
   TDownloadControlOptions = set of TDownloadControlOption;

    {Doc Host Flags:
    http://msdn.microsoft.com/library/default.asp?url=/workshop/browser/hosting/reference/enum/dochostuiflag.asp}
    {TUserInterfaceOption = (DIALOG, DISABLE_HELP_MENU, NO3DBORDER,
        SCROLL_NO, DISABLE_SCRIPT_INACTIVE, OPENNEWWIN, DISABLE_OFFSCREEN,
        FLAT_SCROLLBAR, DIV_BLOCKDEFAULT, ACTIVATE_CLIENTHIT_ONLY,
        OVERRIDEBEHAVIORFACTORY,
        CODEPAGELINKEDFONTS, URL_ENCODING_DISABLE_UTF8,
        URL_ENCODING_ENABLE_UTF8,
         ENABLE_FORMS_AUTOCOMPLETE, ENABLE_INPLACE_NAVIGATION,
        IME_ENABLE_RECONVERSION,
        THEME, NOTHEME, NOPICS, NO3DOUTERBORDER, DISABLE_EDIT_NS_FIXUP,
        LOCAL_MACHINE_ACCESS_CHECK, DISABLE_UNTRUSTEDPROTOCOL,
        HOST_NAVIGATES, ENABLE_REDIRECT_NOTIFICATION, USE_WINDOWLESS_SELECTCONTROL,
        USE_WINDOWED_SELECTCONTROL, ENABLE_ACTIVEX_INACTIVATE_MODE);}
   TUserInterfaceOption = (DisableTextSelect, DisableHelpMenu, DontUse3DBorders,
      DontUseScrollBars, PostponeScriptUntilActive, ForceOpenNewWindow, Reserved_OFFSCREEN,
      ForceFlatScrollBars, InsertDivTagOnEditMode, ActivateUIOnlyOnDocClick,
      ConsultBeforeRetrievingBehavior,
      CheckFontSupportsCodePage, DisableSubmitUrlInUTF8,
      EnableSubmitUrlInUTF8,
      EnablesFormsAutoComplete, ForceSameWindowNavigation,
      EmableImeLocalLanguages,
      EnableThemes, DisableThemes, DisablePicsRatings, DisableFrameSetBorder, DisablesAutoNameSpaceCorrection,
      DisableLocalFileAccess, DisableUntrustedProtocol,
      CheckNavigationDelegatedToHost, EnableRedirectNotification, EnableDomWindlessControls,
      EnableWindowedControls, ForceUserActivationOnActiveXJava);
   TUserInterfaceOptions = set of TUserInterfaceOption;

 {events}
   THResultEvent = function: HRESULT of object;
   TBoolQueryEvent = procedure(var Value: BOOL) of object;
   TMenuPreprocess = procedure(ID: DWORD; Menu: HMENU; const Context: IDispatch) of object;
   TMaskedCtrlCharEvent = procedure(Sender: TCustomEmbeddedWB; MaskedChar: Char) of object;
   TOMWindowMoveEvent = procedure(Sender: TCustomEmbeddedWB; cx, cy: Integer) of object;

  {IDispatch Interface}
   TGetTypeInFoCountEvent = function(var Count: Integer): HRESULT of object;
   TGetTypeInfoEvent = function(Index, LocaleID: Integer; var TypeInfo: ITypeInfo): HRESULT of object;
   TGetIDsOfNamesEvent = function(const IID: TGUID; Names: Pointer;
      NameCount, LocaleID: Integer; DispIDs: Pointer): HRESULT of object;
   TInvokeEvent = procedure(DispID: Integer; const IID: TGUID; LocaleID: Integer;
      Flags: Word; var Params: TagDispParams; VarResult, ExcepInfo, ArgErr: Pointer; Rezult: HRESULT) of object;
   {IDocHostShowUI Interface}
   TShowHelpEvent = function(HWND: THandle; pszHelpFile: POleStr; uCommand: Integer;
      dwData: Longint; ptMouse: TPoint;
      var pDispatchObjectHit: IDispatch): HRESULT of object;
   TShowMessageEvent = function(HWND: THandle;
      lpstrText: POleStr; lpstrCaption: POleStr; dwType: Longint; lpstrHelpFile: POleStr;
      dwHelpContext: Longint; var plResult: LRESULT): HRESULT of object;

   {IDocHostUIHandler Interface}
   TEnableModelessEvent = function(const fEnable: BOOL): HRESULT of object;
   TFilterDataObjectEvent = function(const pDO: IDataObject; var ppDORet: IDataObject): HRESULT of object;
   TGetDropTargetEvent = procedure(var DropTarget: IDropTarget) of object;
   TGetExternalEvent = function(var ppDispatch: IDispatch): HRESULT of object;
   TGetHostInfoEvent = function(var pInfo: TDOCHOSTUIINFO): HRESULT of object;
   TGetOptionKeyPathEvent = function(var pchKey: POleStr; const dw: DWORD): HRESULT of object;
   TOnDocWindowActivateEvent = function(const fActivate: BOOL): HRESULT of object;
   TOnFrameWindowActivateEvent = function(const fActivate: BOOL): HRESULT of object;
   TResizeBorderEvent = function(const prcBorder: PRect;
      const pUIWindow: IOleInPlaceUIWindow;
      const fRameWindow: BOOL): HRESULT of object;
   TShowContextMenuEvent = function(const dwID: DWORD; const ppt: PPOINT;
      const pcmdtReserved: IUnknown; const pdispReserved: IDispatch): HRESULT of object;
   TShowUIEvent = function(const dwID: DWORD; const pActiveObject: IOleInPlaceActiveObject;
      const pCommandTarget: IOleCommandTarget; const pFrame: IOleInPlaceFrame;
      const pDoc: IOleInPlaceUIWindow): HRESULT of object;
   TTranslateAcceleratorEvent = function(const lpMsg: PMSG; const pguidCmdGroup: PGUID;
      const nCmdID: DWORD): HRESULT of object;
   TTranslateUrlEvent = function(const dwTranslate: DWORD; const pchURLIn: POleStr;
      var ppchURLOut: POleStr): HRESULT of object;
   {IDocHostUIHandler2 Interface}
   TGetOverrideKeyPathEvent = function(pchKey: POleStr; dw: DWORD): HRESULT of object;
  {IDropTarget Interface}
   TOnDropEvent = function(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint;
      var dwEffect: Longint{$IFDEF OLDVERSION_COMPATIBLE}; Status: string{$ENDIF}): HResult of object;
   TOnDragEnterEvent = function(const dataObj: IDataObject; grfKeyState: Longint;
      pt: TPoint; var dwEffect: Longint{$IFDEF OLDVERSION_COMPATIBLE}; Status: string{$ENDIF}): HResult of object;
   TOnDragOverEvent = function(grfKeyState: Longint; pt: TPoint; var dwEffect: Longint
{$IFDEF OLDVERSION_COMPATIBLE}; Status: string{$ENDIF}): HResult of object;
{$IFDEF USE_IOLECOMMANDTARGET}
   {IOLECommandTarget Interface}
   TRefreshEvent = procedure(Sender: TObject; CmdID: Integer; var Cancel: Boolean) of object;
   TUnloadEvent = procedure(Sender: TObject) of object;
   TComTargetExecEvent = procedure(CmdGroup: PGUID; nCmdID, nCmdexecopt: DWORD;
      const vaIn: OleVariant; var vaOut: OleVariant; var Rezult: HResult) of object;
{$ENDIF}
   {IServiceProvider Interface}
   TQueryServiceEvent = function(const rsid, iid: TGUID; var Obj: IUnknown): HRESULT of object;
   {INewWindowManager Interface}
   TEvaluateNewWindowEvent = function(pszUrl, pszName, pszUrlContext, pszFeatures: LPCWSTR;
      fReplace: BOOL; dwFlags, dwUserActionTime: DWORD): HRESULT of object;
   {IDownloadManager Interface}
   TDownloadEvent = function(pmk: IMoniker; pbc: IBindCtx; dwBindVerb: DWORD;
      grfBINDF: DWORD; pBindInfo: PBindInfo; pszHeaders: PWidechar;
      pszRedir: PWidechar; uiCP: UINT): HRESULT of object;
   {IZoomEvents Interface}
   TZoomPercentChangedEvent = function(const ulZoomPercent: uLong): HResult of object;
   {Script Error handling}
   TScriptErrorAction = (eaContinue, eaCancel, eaAskUser);
   TScriptErrorEvent = procedure(Sender: TObject; ErrorLine, ErrorCharacter, ErrorCode, ErrorMessage, ErrorUrl: string;
       var ScriptErrorAction: TScriptErrorAction) of object;


   { TCustomEmbeddedWB }
   TCustomEmbeddedWB = class(TEWB
         , IDispatch //http://msdn.microsoft.com/library/default.asp?url=/library/en-us/automat/html/ebbff4bc-36b2-4861-9efa-ffa45e013eb5.asp
         , IDocHostShowUI //http://msdn.microsoft.com/library/default.asp?url=/workshop/browser/hosting/reference/ifaces/idochostshowui/idochostshowui.asp
         , IDocHostUIHandler //http://msdn.microsoft.com/library/default.asp?url=/workshop/browser/hosting/reference/ifaces/idochostuihandler/idochostuihandler.asp
         , IDocHostUIHandler2 //http://msdn.microsoft.com/library/default.asp?url=/workshop/browser/hosting/reference/ifaces/dochostuihandler2/idochostuihandler2.asp
         , IDropTarget //http://msdn.microsoft.com/library/default.asp?url=/library/en-us/com/html/13fbe834-1ef8-4944-b2e4-9f5c413c65c8.asp
{$IFDEF USE_IOLECOMMANDTARGET}
         , IOleCommandTarget //http://msdn.microsoft.com/library/default.asp?url=/library/en-us/com/html/5c8b455e-7740-4f71-aef6-27390a11a1a3.asp
{$ENDIF}
         , IServiceProvider //http://msdn.microsoft.com/library/default.asp?url=/workshop/components/com/reference/ifaces/iserviceprovider/iserviceprovider.asp
         , INewWindowManager //http://msdn.microsoft.com/library/default.asp?url=/library/en-us/shellcc/platform/shell/reference/ifaces/inewwindowmanager/evaluatenewwindow.asp
         , IDownloadManager //http://msdn.microsoft.com/workshop/browser/ext/reference/ifaces/idownloadmanager/idownloadmanager.asp
         , IHTMLOMWindowServices //http://msdn.microsoft.com/library/default.asp?url=/workshop/browser/hosting/reference/ifaces/IHTMLOMWindowServices/IHTMLOMWindowServices.asp
         , IZoomEvents//http://msdn2.microsoft.com/en-us/library/aa770056.aspx)
         //, IProtectFocus //http://msdn2.microsoft.com/en-us/library/aa361771.aspx

         )
   private 
      FOnZoomPercentChanged: TZoomPercentChangedEvent;
      FOnGetIDsOfNames: TGetIDsOfNamesEvent;
      FonGetTypeInfo: TGetTypeInfoEvent;
      FonGetTypeInfoCount: TGetTypeInfoCountEvent;
      FOnInvoke: TInvokeEvent;
      FDownloadControlOptions: TDownloadControlOptions;
      FOnShowMessage: TShowMessageEvent;
      FOnShowHelp: TShowHelpEvent;
      FHelpFile: string;
      fOptionKeyPath: string;
      fOverOptionKeyPath: Boolean;
      FOnFilterDataObject: TFilterDataObjectEvent;
      FOnGetExternal: TGetExternalEvent;
      FOnGethostinfo: TGetHostInfoEvent;
      FUserInterfaceOptions: TUserInterfaceOptions;
      FOnEnableModeless: TEnableModelessEvent;
{$IFDEF OLDVERSION_COMPATIBLE}
      FOnGetOptionKeyPath: TGetOptionKeyPathEvent;
      FOnGetOverrideKeyPath: TGetOVerrideKeypathEvent;
{$ENDIF}
      FOnGetDropTarget: TGetDropTargetEvent;
      FOnHideUI: THResultEvent;
      FOnOnDocWindowActivate: TOnDocWindowActivateEvent;
      FOnOnFrameWindowActivate: TOnFrameWindowActivateEvent;
      FOnResizeBorder: TResizeBorderEvent;
      FOnShowContextmenu: TShowContextMenuEvent;
      FOnShowUI: TShowUIEvent;
      FOnTranslateAccelerator: TTranslateAcceleratorEvent;
      FOnTranslateUrL: TTranslateUrlEvent;
      FOnUpdateUI: THResultEvent;
      FOnDragLeaveEvent: THResultEvent;
      FOnDragEnterEvent: TOnDragEnterEvent;
      FOnDragOverEvent: TOnDragOverEvent;
      FOnDropEvent: TOnDropEvent;
      FOnScriptError: TScriptErrorEvent;
      FScriptErrorAction : TScriptErrorAction;
{$IFDEF USE_IOLECOMMANDTARGET}
      FOnUnload: TUnloadEvent;
      FOnRefresh: TRefreshEvent;
      fOnCommandExec: TComTargetExecEvent;
{$ENDIF}
      FOnQueryService: TQueryServiceEvent;
      FOnEvaluateNewWindow: TEvaluateNewWindowEvent;
       //FCanGrabFocus: Boolean;
      //FOnAllowFocusChange: TBoolQueryEvent;
      FOnDownload: TDownloadEvent;
      FDropHandlingType: TDragDropHandlingType;
      FZoomPercent: integer;
      FDesignMode: Boolean;
      FDisabledPopupMenus: TIEPopupMenus;
      fOnFilterPopupMenu: TMenuPreprocess;
      fOnMaskedCtrlChar: TMaskedCtrlCharEvent;
      fCtrlCharMask: string;
      FOnResize: TOMWindowMoveEvent;
      FOnMoveBy: TOMWindowMoveEvent;
      FOnMove: TOMWindowMoveEvent;
      FOnResizeBy: TOMWindowMoveEvent;
      fFloatingHosting: Boolean;
      procedure SetDownloadOptions(const Value: TDownloadControlOptions);
      procedure SetUserInterfaceOptions(const Value: TUserInterfaceOptions);
      function GetDoc2: IHtmlDocument2;
      function GetElemByID(const ID: Widestring): IHTMLElement;
      function GetZoom: Integer;
      procedure SetZoom(const Value: Integer);
      procedure setOpticalZoom(const Value: integer);
      function _getCookie: WideString;
      function GetCharSet: WideString;
      procedure SetCharSet(const Value: WideString);
      procedure SetDropHandlingType(const Value: TDragDropHandlingType);
      procedure SetDesignMode(const Value: Boolean);
      function getDocDesignMode: TDocDesignMode;
      procedure setDocDesignMode(const Value: TDocDesignMode);
   protected
      ActualHandle: HWND; //jls
      procedure CreateWnd; override; //jls
      procedure DestroyWnd; override; //jls
   protected
     {IDispatch Interface}
      function GetIDsOfNames(const IID: TGUID; Names: Pointer;
         NameCount, LocaleID: Integer; DispIDs: Pointer): HRESULT; stdcall;
      function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HRESULT; stdcall;
      function GetTypeInfoCount(out Count: Integer): HRESULT; stdcall;
      function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
         Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HRESULT; stdcall;
      {IDocHostShowUI Interface }
      function ShowHelp(HWND: THandle; pszHelpFile: POleStr; uCommand: Integer;
         dwData: Longint; ptMouse: TPoint; var pDispatchObjectHit: IDispatch): HRESULT; stdcall;
      function ShowMessage(HWND: THandle; lpstrText: POleStr; lpstrCaption: POleStr;
         dwType: Longint; lpstrHelpFile: POleStr; dwHelpContext: Longint;
         var plResult: LRESULT): HRESULT; stdcall;
      {IDocHostUIHandler Interface}
      function EnableModeless(const fEnable: BOOL): HRESULT; stdcall;
      function FilterDataObject(const pDO: IDataObject; out ppDORet: IDataObject): HRESULT; stdcall;
      function GetDropTarget(const pDropTarget: IDropTarget;
         out ppDropTarget: IDropTarget): HRESULT; stdcall;
      function GetExternal(out ppDispatch: IDispatch): HRESULT; stdcall;
      function GetHostInfo(var pInfo: TDOCHOSTUIINFO): HRESULT; stdcall;
      function GetOptionKeyPath(out pchKey: POleStr; const dw: DWORD): HRESULT; stdcall;
      function HideUI: HRESULT; stdcall;
      function OnDocWindowActivate(const fActivate: BOOL): HRESULT; stdcall;
      function OnFrameWindowActivate(const fActivate: BOOL): HRESULT; stdcall;
      function ResizeBorder(const prcBorder: PRECT; const pUIWindow: IOleInPlaceUIWindow;
         const FrameWindow: BOOL): HRESULT; stdcall;
      function ShowContextMenu(const dwID: DWORD; const ppt: PPOINT;
         const pcmdtReserved: IUnknown; const pdispReserved: IDispatch): HRESULT; stdcall;
      function ShowUI(const dwID: DWORD; const pActiveObject: IOleInPlaceActiveObject;
         const pCommandTarget: IOleCommandTarget; const pFrame: IOleInPlaceFrame;
         const pDoc: IOleInPlaceUIWindow): HRESULT; stdcall;
      function TranslateAccelerator(const lpMsg: PMSG; const pguidCmdGroup: PGUID;
         const nCmdID: DWORD): HRESULT; stdcall;
      function TranslateUrl(const dwTranslate: DWORD; const pchURLIn: POLESTR;
      out ppchURLOut: POLESTR): HRESULT; stdcall;
      function UpdateUI: HRESULT; stdcall;
       {IDocHostUIHandler2 Interface}
      function GetOverrideKeyPath(out pchKey: POleStr; dw: DWORD): HRESULT; stdcall;
      {IDropTarget Interface}
      function DragEnter(const dataObj: IDataObject; grfKeyState: Longint;
         pt: TPoint; var dwEffect: Longint): HResult; stdcall;
      function IDropTarget.DragOver = DropTargetDragOver;
      function DropTargetDragOver(grfKeyState: Longint; pt: TPoint;
         var dwEffect: Longint): HResult; stdcall;
      function DragLeave: HResult; stdcall;
      function Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint;
         var dwEffect: Longint): HResult; stdcall;
{$IFDEF USE_IOLECOMMANDTARGET}
     {IOleCommandTarget interface}
      function IOleCommandTarget.QueryStatus = CommandTarget_QueryStatus;
      function CommandTarget_QueryStatus(CmdGroup: PGUID; cCmds: Cardinal;
         prgCmds: POleCmd; CmdText: POleCmdText): HResult; stdcall;
      function IOleCommandTarget.Exec = CommandTarget_Exec;
      function CommandTarget_Exec(CmdGroup: PGUID; nCmdID, nCmdexecopt: DWORD;
         const vaIn: OleVariant; var vaOut: OleVariant): HResult; stdcall;
{$ENDIF}
    {IServiceProvider Interface}
      function QueryService(const rsid, iid: TGUID; out Obj): HRESULT; stdcall;
    {INewWindowManager Interface}
      function EvaluateNewWindow(pszUrl, pszName, pszUrlContext, pszFeatures: LPCWSTR;
         fReplace: BOOL; dwFlags, dwUserActionTime: DWORD): HRESULT; stdcall;
    {IProtectFocus IE7 interface}
    //function AllowFocusChange(out pfAllow: BOOL): HRESULT; stdcall;
    {IDownloadManager Interface}
      function Download(
         pmk: IMoniker; // Identifies the object to be downloaded
         pbc: IBindCtx; // Stores information used by the moniker to bind
         dwBindVerb: DWORD; // The action to be performed during the bind
         grfBINDF: DWORD; // Determines the use of URL encoding during the bind
         pBindInfo: PBindInfo; // Used to implement IBindStatusCallback::GetBindInfo
         pszHeaders: PWidechar; // Additional headers to use with IHttpNegotiate
         pszRedir: PWidechar; // The URL that the moniker is redirected to
         uiCP: UINT // The code page of the object's display name
         ): HRESULT; stdcall;
    {IHTMLOMWindowServices Interface}
      function resizeBy(const x, y: Integer): HRESULT; stdcall;
      function resizeTo(const x, y: Integer): HRESULT; stdcall;
      function moveBy(const x, y: Integer): HRESULT; stdcall;
      function moveTo(const x, y: Integer): HRESULT; stdcall;
     {IZoomEvents  interface}
      function OnZoomPercentChanged(const ulZoomPercent: uLong): HResult; stdcall;

   protected
      FDownloadOptionValue: Longint;
      FUserInterfaceValue: Cardinal;
      procedure UpdateDownloadControlValue;
      procedure UpdateUserInterfaceValue;
      function CopyOptionKeyPath(Overrided: Boolean): PWideChar;
      function DoFilterMsg(const lpMsg: PMSG): HRESULT; virtual;
      function ScriptErrorHandler(const vaIn: OleVariant; var vaOut: OleVariant): HRESULT; virtual;
      procedure DoQueryService(const rsid, iid: TGUID; out Obj); virtual;
      function FilterPopupMenu: Boolean; virtual;
      procedure DoFilterPopupMenu(ID: DWORD; Menu: HMENU; const Context: IDispatch); virtual;
      procedure MoveParentForm(x, y: Integer; Delta: Boolean);
      procedure ResizeParentForm(w, h: Integer; Delta: Boolean);
   public
      class function dwEffectToStr(Command: Int64): string;
      class procedure DropEffect(grfKeyState: Longint; var dwEffect: longint);
      constructor Create(AOwner: TComponent); override;

      function InvokeCommand(CmdGroup: PGUID; Cmd, nCmdexecopt: DWORD;
         var vaIn, vaOut: OleVariant): HResult; overload;
      function InvokeCommand(CmdGroup: PGUID; Cmd: DWORD): HResult; overload;
      function QueryCommandStatus(CmdGroup: PGUID; cCmds: Cardinal;
         prgCmds: POleCmd; CmdText: POleCmdText): HResult;
      function QueryCMDEnabled(CmdGroup: PGUID; cmdID: Cardinal): Boolean;
      function QueryCMDLatched(CmdGroup: PGUID; cmdID: Cardinal): Boolean;
      function QueryCMDStatus(CmdGroup: PGUID; cmdID: Cardinal): OLECMDF;
      function QueryCMDArrayStatus(CmdGroup: PGUID; cmds: TOleCmdArray): Boolean;

      procedure Client2HostWin(var CX, CY: Integer); // just call it in OnClientToHostWindow handler

      function GetIEWin(const ClassName: string): HWND;
      procedure SetFocusToDoc;
      procedure SetFocusToParent;
      property Zoom: Integer read getZoom write setZoom;
      property ZoomPercent: integer read FZoomPercent write setOpticalZoom default 100;
      property Cookie: Widestring read _getCookie;
      property DesignMode: Boolean read FDesignMode write SetDesignMode;
    {html functions}
      property Doc2: IHtmlDocument2 read GetDoc2;
      property DocDesignMode: TDocDesignMode read getDocDesignMode write setDocDesignMode;
      property CharartersSet: Widestring read GetCharSet write SetCharSet;
      property ElementByID[const ID: Widestring]: IHTMLElement read getElemByID;
      function ScrollToElement(Element: IHTMLElement): Boolean;

      property CtrlCharMask: string read fCtrlCharMask write fCtrlCharMask;
      //property CanGrabFocus: Boolean read fCanGrabFocus write fCanGrabFocus;
      //property OnAllowFocusChange: TBoolQueryEvent read fOnAllowFocusChange write fOnAllowFocusChange;

   published
      property DownloadOptions: TDownloadControlOptions read FDownloadControlOptions
         write SetDownloadOptions;
      property UserInterfaceOptions: TUserInterfaceOptions read FUserInterfaceOptions
         write SetUserInterfaceOptions;
      property HelpFile: string read FHelpFile write FHelpFile;
      property OptionKeyPath: string read fOptionKeyPath write fOptionKeyPath;
      property OverrideOptionKeyPath: Boolean read fOverOptionKeyPath write fOverOptionKeyPath default False;

      property DropHandlingType: TDragDropHandlingType read FDropHandlingType write setDropHandlingType default ddtMS;
      property DisabledPopupMenus: TIEPopupMenus
         read FDisabledPopupMenus write FDisabledPopupMenus default [];
      property FloatingHosting: Boolean read fFloatingHosting write fFloatingHosting default False;
      property ScriptErrorAction: TScriptErrorAction read FScriptErrorAction
              write FScriptErrorAction default eaContinue;
      property OnGetIDsOfNames: TGetIDsOfNamesEvent read FOnGetIDsOfNames write FOnGetIdsOfNames;
      property OnGetTypeInfo: TGetTypeInfoEvent read FonGetTypeInfo write FOnGetTypeInfo;
      property OnGetTypeInfoCount: TGetTypeInfoCountEvent read FonGetTypeInfoCount
         write FOnGetTypeInfoCount;
      property OnInvoke: TInvokeEvent read FOnInvoke write FOnInvoke;
      property OnShowHelpRequest: TShowHelpEvent read FOnShowHelp write FOnShowHelp;
      property OnShowMessage: TShowMessageEvent read FOnShowMessage write FOnShowMessage;
      property OnFilterDataObject: TFilterDataObjectEvent read FOnFilterDataObject
         write FOnFilterDataObject;
      property OnGetExternal: TGetExternalEvent read FOnGetExternal write FOnGetExternal;
      property OnGetHostInfo: TGetHostInfoEvent read FOnGethostinfo write fongethostinfo;
      property OnEnableModeless: TEnableModelessEvent read FOnEnableModeless
         write FOnEnableModeless;
{$IFDEF OLDVERSION_COMPATIBLE}
      property OnGetOptionKeyPath: TGetOptionKeyPathEvent read FOnGetOptionKeyPath
         write FOnGetOptionKeyPath;
      property OnGetOverrideKeyPath: TGetOVerrideKeypathEvent read FOnGetOverrideKeyPath
         write FOnGetOverrideKeyPath;
{$ENDIF}
      property OnZoomPercentChange: TZoomPercentChangedEvent read FOnZoomPercentChanged write FOnZoomPercentChanged;
      property OnGetDropTarget: TGetDropTargetEvent read FOnGetDropTarget write FOnGetDropTarget;
      property OnHideUI: THResultEvent read FOnHideUI write FOnHideUI;
      property OnOnDocWindowActivate: TOnDocWindowActivateEvent read FOnOnDocWindowActivate
         write FOnOnDocWindowActivate;
      property OnOnFrameWindowActivate: TOnFrameWindowActivateEvent read FOnOnFrameWindowActivate
         write FOnOnFrameWindowActivate;
      property OnResizeBorder: TResizeBorderEvent read FOnResizeBorder write FOnResizeBorder;
      property OnShowContextMenu: TShowContextMenuEvent read FOnShowContextmenu
         write FOnShowContextmenu;
      property OnShowUI: TShowUIEvent read FOnShowUI write FOnShowUI;
      property OnTranslateAccelerator: TTranslateAcceleratorEvent read FOnTranslateAccelerator
         write FOnTranslateAccelerator;
      property OnTranslateUrl: TTranslateUrlEvent read FOnTranslateUrL
         write FOnTranslateUrL;
      property OnUpdateUI: THResultEvent read FOnUpdateUI write FOnUpdateUI;

      property OnDragEnter: TOnDragEnterEvent read FOnDragEnterEvent write FOnDragEnterEvent;
      property OnDragLeave: THResultEvent read FOnDragLeaveEvent write FOnDragLeaveEvent;
      property OnDragOver2: TOnDragOverEvent read FOnDragOverEvent write FOnDragOverEvent;
      property OnDropEvent: TOnDropEvent read FOnDropEvent write FOnDropEvent;

{$IFDEF USE_IOLECOMMANDTARGET}
      property OnRefresh: TRefreshEvent read FOnRefresh write FOnRefresh;
      property OnUnload: TUnloadEvent read FOnUnload write FOnUnload;
      property OnCommandExec: TComTargetExecEvent read fOnCommandExec write fOnCommandExec;
{$ENDIF}
      property OnQueryService: TQueryServiceEvent read FOnQueryService write FOnQueryService;
      property OnEvaluateNewWindow: TEvaluateNewWindowEvent read FOnEvaluateNewWindow
         write FOnEvaluateNewWindow;
      property OnFileDownload: TDownloadEvent read FOnDownload write FOnDownload;
      property OnFilterPopupMenu: TMenuPreprocess read fOnFilterPopupMenu write fOnFilterPopupMenu;
      property OnMaskedCtrlChar: TMaskedCtrlCharEvent read fOnMaskedCtrlChar write fOnMaskedCtrlChar;

      property OnMove: TOMWindowMoveEvent read FOnMove write FOnMove;
      property OnMoveBy: TOMWindowMoveEvent read FOnMoveBy write FOnMoveBy;
      property OnResize: TOMWindowMoveEvent read FOnResize write FOnResize;
      property OnResizeBy: TOMWindowMoveEvent read FOnResizeBy write FOnResizeBy;
   end;

   TEwbCore = class(TCustomEmbeddedWB)
   private
    function IsCtrlCharMask: Boolean;
   published
    property CtrlCharMask stored IsCtrlCharMask;
   end;

function TaskAllocWideString(const S: string): PWChar;
function ColorToHTML(const Color: TColor): string;

//this two functions for using in custom OnShowContextMenu handler.
function IsSeTIEPopupMenus(ID: DWORD; rcm: TIEPopupMenus): Boolean;
function ShowRightClickMenu(dwID: DWORD;
   const Target: IUnknown; const Context: IDispatch;
   const ppt: PPOINT;
   const EncodingSubMenu: OleVariant;
   preprocess: TMenuPreprocess = nil): Boolean;


implementation
uses SysUtils, ComObj;

function AnsiIndexStr(const AText: string; const AValues: array of string): Integer;
var
  I: Integer;
begin
  Result := -1;
  for I := Low(AValues) to High(AValues) do
    if AnsiSameStr(AText, AValues[I]) then
    begin
      Result := I;
      Break;
    end;
end;

function TaskAllocWideString(const S: string): PWChar;
var
   Len: Integer;
begin
   Len := Length(S) + 1;
   Result := CoTaskMemAlloc(2 * Len);
   StringToWideChar(S, Result, Len);
end;

function ColorToHTML(const Color: TColor): string;
var
   ColorRGB: Integer;
begin
   ColorRGB := ColorToRGB(Color);
   Result := Format(
      '#%0.2X%0.2X%0.2X',
      [GetRValue(ColorRGB), GetGValue(ColorRGB), GetBValue(ColorRGB)]
      );
end;

function IsSeTIEPopupMenus(ID: DWORD; rcm: TIEPopupMenus): Boolean;
begin
   Result := (rcmAll in rcm) or
      ((ID in [0..9]) and (TIEPopupMenu(ID) in rcm));
end;

function ShowRightClickMenu(dwID: DWORD; const Target: IUnknown; const Context: IDispatch;
   const ppt: PPOINT; const EncodingSubMenu: OleVariant;
   preprocess: TMenuPreprocess = nil): Boolean;
var
   ShDocLcHandle: THandle;
   OleCommandTarget: IOleCommandTarget;
   OleWindow: IOleWindow;
   WindowHandle: HWND;
   ParentMenu, SubMenu: HMENU;
   SubMenuItemInfo: MENUITEMINFO;
   PopupResult: LongBool;
begin
   Result := False;
   ShDocLcHandle := GetSHDOCLCModule;
   if ShDocLcHandle = 0 then
      Exit;

   if Supports(Target, IOleCommandTarget, OleCommandTarget) and
      Supports(Target, IOleWindow, OleWindow) and
      ActiveX.Succeeded(OleWindow.GetWindow(WindowHandle)) then
      begin
         ParentMenu := Windows.LoadMenu(ShDocLcHandle, MAKEINTRESOURCE(CContextMenuID));
         if ParentMenu <> 0 then
            try
               SubMenu := GetSubMenu(ParentMenu, dwID);
               FillChar(SubMenuItemInfo, SizeOf(SubMenuItemInfo), 0);
               SubMenuItemInfo.cbSize := SizeOf(MENUITEMINFO);
               SubMenuItemInfo.fMask := MIIM_SUBMENU;
               SubMenuItemInfo.hSubMenu := HMENU(@EncodingSubMenu);
               SetMenuItemInfo(SubMenu, IDM_LANGUAGE, False, SubMenuItemInfo);

               if Assigned(preprocess) then
                  preprocess(dwID, SubMenu, Context);

               PopupResult := Windows.TrackPopupMenuEx(SubMenu, TPM_LEFTALIGN
                  or TPM_TOPALIGN or TPM_RETURNCMD or TPM_RIGHTBUTTON
                  or TPM_HORPOSANIMATION or TPM_VERPOSANIMATION, ppt^.X, ppt^.Y, WindowHandle, nil);
               if PopupResult then
                  SendMessage(WindowHandle, WM_COMMAND, MakeWParam(LOWORD(PopupResult), 0), 0);
               Result := True;
            finally
               DestroyMenu(ParentMenu);
            end;
      end;
end;

type
{ TnoDragDrop }
   TnoDragDrop = class(TInterfacedObject, IDropTarget)
   protected
      function DragEnter(const dataObj: IDataObject; grfKeyState: Longint;
         pt: TPoint; var dwEffect: Longint): HResult; stdcall;
      function DragOver(grfKeyState: Longint; pt: TPoint;
         var dwEffect: Longint): HResult; stdcall;
      function DragLeave: HResult; stdcall;
      function Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint;
         var dwEffect: Longint): HResult; stdcall;
   end;

function TnoDragDrop.DragEnter(const dataObj: IDataObject; grfKeyState: Integer;
   pt: TPoint; var dwEffect: Integer): HResult;
begin
   dwEffect := DROPEFFECT_NONE;
   Result := S_OK;
end;

function TnoDragDrop.DragLeave: HResult;
begin
   Result := S_OK;
end;

function TnoDragDrop.DragOver(grfKeyState: Integer; pt: TPoint;
   var dwEffect: Integer): HResult;
begin
   dwEffect := DROPEFFECT_NONE;
   Result := S_OK;
end;

function TnoDragDrop.Drop(const dataObj: IDataObject; grfKeyState: Integer;
   pt: TPoint; var dwEffect: Integer): HResult;
begin
   dwEffect := DROPEFFECT_NONE;
   Result := S_OK;
end;

{ TCustomEmbeddedWB }

class function TCustomEmbeddedWB.dwEffectToStr(Command: Int64): string;
const
   E_UNSPEC = E_Fail;
begin
   case (Command) of
      DROPEFFECT_NONE: Result := 'Drop target cannot accept the data.';
      DROPEFFECT_COPY: Result := 'Drag source should copy the data.';
      DROPEFFECT_MOVE: Result := 'Drag source should remove the data.';
      DROPEFFECT_LINK: Result := 'Drag source should create a link to the original data.';
      DRAGDROP_S_DROP: Result := 'The drag-and-drop operation was successful.';
      DRAGDROP_S_CANCEL: Result := 'The drag-and-drop operation was canceled.';
      DRAGDROP_S_USEDEFAULTCURSORS: Result := 'Successful completion. Restoring defaults.';
      DRAGDROP_E_INVALIDHWND: Result := 'Invalid handle returned in the hwnd parameter.';
      DRAGDROP_E_NOTREGISTERED: Result := 'Failed to revoke a drop target that has not been registered.';
      E_UNSPEC: Result := 'Unexpected error occurred.';
      E_OUTOFMEMORY: Result := 'Out of memory.';
      7: Result := 'operation was successful.';
      else
         Result := 'Unknown.';
   end;
end;

class procedure TCustomEmbeddedWB.DropEffect(grfKeyState: Longint; var dwEffect: longint);
begin
   if (grfKeyState and MK_CONTROL = 0) and (grfKeyState and MK_SHIFT <> 0) and
      (dwEffect and DropEffect_Move <> 0) then
      dwEffect := DropEffect_Move
   else
      if (grfKeyState and MK_CONTROL <> 0) and (grfKeyState and MK_SHIFT <> 0) and
         (dwEffect and DropEffect_Link <> 0) then
         dwEffect := DropEffect_Link
      else
         if (dwEffect and DropEffect_Copy <> 0) then
            dwEffect := DropEffect_Copy
         else
            if (dwEffect and DropEffect_Move <> 0) then
               dwEffect := DropEffect_Move
            else
               if (dwEffect and DropEffect_Link <> 0) then
                  dwEffect := DropEffect_Link
               else
                  dwEffect := DropEffect_None;
end;

{function TCustomEmbeddedWB.AllowFocusChange(out pfAllow: BOOL): HRESULT;
begin
   Result := S_OK;
   pfAllow := CanGrabFocus;
   if Assigned(OnAllowFocusChange) then
      OnAllowFocusChange(pfAllow);
end; }

function TCustomEmbeddedWB.CopyOptionKeyPath(Overrided: Boolean): PWideChar;
begin
   if (OptionKeyPath = '') or
      (OverrideOptionKeyPath xor Overrided) then
      Result := nil
   else
      Result := TaskAllocWideString(OptionKeyPath);
end;

constructor TCustomEmbeddedWB.Create(AOwner: TComponent);
begin
   inherited;
   ScriptErrorAction := eaContinue;
   DownloadOptions := [DownloadImages, DownloadVideos, DownloadBGSounds];
   UserInterfaceOptions := [];
   FDropHandlingType := ddtMS;
   FCtrlCharMask := 'N';
end;

procedure TCustomEmbeddedWB.CreateWnd; //jls
begin
   if (ActualHandle <> 0) and IsWindow(ActualHandle) then
      begin
         WindowHandle := ActualHandle;
         ActualHandle := 0;
         Windows.SetParent(WindowHandle, TWinControl(Self).Parent.Handle);
         MoveWindow(WindowHandle, 0, 0, TWinControl(Self).Parent.Width,
            TWinControl(Self).Parent.Height, true); //Force a resize on the client window
      end
   else
      inherited;
end;

procedure TCustomEmbeddedWB.DestroyWnd; //jls
begin
   if (csDestroying in ComponentState) then
      inherited
   else
      begin
         Windows.SetParent(WindowHandle, Forms.Application.Handle); //Parent to the Application window which is 0x0 in size
         ActualHandle := WindowHandle; //save the WindowHandle
         WindowHandle := 0; //set it to 0 so Createwnd will be called again...
      end;
end;

function TCustomEmbeddedWB.EnableModeless(const fEnable: BOOL): HRESULT;
begin
   Result := S_OK;
   if Assigned(FOnEnableModeless) then
      Result := FOnEnableModeless(fEnable);
end;

function TCustomEmbeddedWB.EvaluateNewWindow(pszUrl, pszName, pszUrlContext,
   pszFeatures: LPCWSTR; fReplace: BOOL; dwFlags,
   dwUserActionTime: DWORD): HRESULT;
begin
   if Assigned(fOnEvaluateNewWindow) then
      Result := fOnEvaluateNewWindow(pszUrl, pszName, pszUrlContext, pszFeatures,
         fReplace, dwFlags, dwUserActionTime)
   else
      Result := E_FAIL;
end;

function TCustomEmbeddedWB.FilterDataObject(const pDO: IDataObject;
   out ppDORet: IDataObject): HRESULT;
begin
   if Assigned(FOnFilterDataObject) then
      Result := FOnFilterDataObject(pDO, ppDORet)
   else
      Result := S_FALSE;
end;

function TCustomEmbeddedWB.GetDoc2: IHtmlDocument2;
begin
   if not Supports(Document, IHtmlDocument2, Result) then
      raise Exception.Create('It''s not html document');
end;

function TCustomEmbeddedWB.GetExternal(out ppDispatch: IDispatch): HRESULT;
begin
   if Assigned(FOnGetExternal) then
      Result := FOnGetExternal(ppDispatch)
   else
      Result := S_FALSE;
end;

function TCustomEmbeddedWB.GetHostInfo(var pInfo: TDOCHOSTUIINFO): HRESULT;
begin
   FillChar(pInfo, SizeOf(TDOCHOSTUIINFO), #0);
   pInfo.cbSize := SizeOf(pInfo);
   pInfo.dwFlags := FUserInterfaceValue;
   pInfo.dwDoubleClick := DOCHOSTUIDBLCLK_DEFAULT;

   if Assigned(FOnGetHostInfo) then
      Result := FOnGetHostInfo(pInfo)
   else
      Result := S_OK;
end;

function TCustomEmbeddedWB.GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount,
   LocaleID: Integer; DispIDs: Pointer): HRESULT;
begin
   if Assigned(FOnGetIDsOfNames) then
      Result := FOnGetIDsOfNames(IID, Names, NameCount, LocaleID, DispIds)
   else
      Result := inherited GetIDsOfNames(IID, Names, NameCount, LocaleID, DispIDs);
end;

function TCustomEmbeddedWB.GetIEWin(const ClassName: string): HWND;
var
   szClass: array[0..255] of char;
begin
   if HandleAllocated then
      begin
         Result := GetWindow(WindowHandle, GW_CHILD);
         repeat
            if (GetClassName(Result, szClass, SizeOf(szClass)) > 0) and
               (AnsiStrComp(PChar(ClassName), szClass) = 0) then
               Exit;
            Result := GetWindow(Result, GW_CHILD);
         until not IsWindow(Result);
      end;
   Result := 0;
end;

function TCustomEmbeddedWB.GetOptionKeyPath(out pchKey: POleStr;
   const dw: DWORD): HRESULT;
begin
   pchKey := CopyOptionKeyPath(False);
   Result := S_OK;
{$IFDEF OLDVERSION_COMPATIBLE}
   if Assigned(FOnGetOptionKeyPath) then
      Result := FOnGetOptionKeyPath(pchKey, dw)
{$ENDIF}
end;

function TCustomEmbeddedWB.GetOverrideKeyPath(out pchKey: POleStr; dw: DWORD): HRESULT;
begin
   pchKey := CopyOptionKeyPath(True);
   Result := S_OK;
{$IFDEF OLDVERSION_COMPATIBLE}
   if Assigned(FOnGetOverrideKeyPath) then
      Result := FOnGetOverrideKeyPath(pchKey, dw);
{$ENDIF}
end;

function TCustomEmbeddedWB.GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HRESULT;
begin
   if Assigned(FOnGetTypeInfo) then
      Result := FOnGetTypeInfo(Index, LocaleID, ITypeInfo(TypeInfo))
   else
      Result := inherited GetTypeInfo(Index, LocaleID, TypeInfo);
end;

function TCustomEmbeddedWB.GetTypeInfoCount(out Count: Integer): HRESULT;
begin
   Count := 0;
   if Assigned(FOnGetTypeInfoCount) then
      Result := FOnGetTypeInfoCount(Count)
   else
      Result := inherited GetTypeInfoCount(Count);
end;

function TCustomEmbeddedWB.GetZoom: Integer;
var
   vaIn, vaOut: OleVariant;
begin
   vaIn := null;
   InvokeCommand(nil, OLECMDID_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut);
   Result := vaOut;
end;

procedure TCustomEmbeddedWB.SetZoom(const Value: Integer);
var
   vaIn, vaOut: OleVariant;
   Range: DWORD;
begin
   InvokeCommand(nil, OLECMDID_GETZOOMRANGE, OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut);
   Range := DWORD(vaOut);
   if Value < LoWord(Range) then
      vaIn := LoWord(Range)
   else
      if Value > HiWord(Range) then
         vaIn := HiWord(Range)
      else
         vaIn := Value;
   InvokeCommand(nil, OLECMDID_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut);
end;

procedure TCustomEmbeddedWB.setOpticalZoom(const Value: integer);
var
   vaIn, vaOut: OleVariant;
   Range: DWORD;
begin
   if FZoomPercent <> Value then
   begin
     FZoomPercent := Value;
     InvokeCommand(nil, OLECMDID_OPTICAL_GETZOOMRANGE, OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut);
     Range := DWORD(vaOut);
     if Value < LoWord(Range) then
        vaIn := LoWord(Range)
     else
        if Value > HiWord(Range) then
           vaIn := HiWord(Range)
        else
           vaIn := Value;
     InvokeCommand(nil, OLECMDID_OPTICAL_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut);
     if Assigned(FOnZoomPercentChanged) then
        FOnZoomPercentChanged(vaOut);
   end;
end;

function TCustomEmbeddedWB.HideUI: HRESULT;
begin
   if Assigned(FOnHideUI) then
      Result := FOnHideUI
   else
      Result := S_FALSE;
end;

function TCustomEmbeddedWB.InvokeCommand(CmdGroup: PGUID; Cmd, nCmdexecopt: DWORD;
   var vaIn, vaOut: OleVariant): HResult;
var
   CmdTarget: IOleCommandTarget;
begin
   if Supports(Document, IOleCommandTarget, CmdTarget) then
      Result := CmdTarget.Exec(CmdGroup, Cmd, nCmdexecopt, vaIn, vaOut)
   else
      Result := E_UNEXPECTED;
end;

function TCustomEmbeddedWB.InvokeCommand(CmdGroup: PGUID; Cmd: DWORD): HResult;
var
   CmdTarget: IOleCommandTarget;
   vaIn, vaOut: Olevariant;
begin
   if Supports(Document, IOleCommandTarget, CmdTarget) then
      Result := CmdTarget.Exec(CmdGroup, Cmd, OLECMDEXECOPT_DODEFAULT, vaIn, vaOut)
   else
      Result := E_UNEXPECTED;
end;

function TCustomEmbeddedWB.QueryCMDArrayStatus(CmdGroup: PGUID;
   cmds: TOleCmdArray): Boolean;
var
   CmdTarget: IOleCommandTarget;
begin
   if Supports(Document, IOleCommandTarget, CmdTarget) then
      Result := CmdTarget.QueryStatus(CmdGroup,
         Length(cmds), @Cmds, nil) = S_OK
   else
      Result := False;
end;

function TCustomEmbeddedWB.QueryCMDEnabled(CmdGroup: PGUID; cmdID: Cardinal): Boolean;
begin
   Result := (QueryCMDStatus(CmdGroup, cmdID) and OLECMDF_ENABLED) <> 0;
end;

function TCustomEmbeddedWB.QueryCMDLatched(CmdGroup: PGUID; cmdID: Cardinal): Boolean;
begin
   Result := (QueryCMDStatus(CmdGroup, cmdID) and OLECMDF_LATCHED) <> 0;
end;

function TCustomEmbeddedWB.QueryCMDStatus(CmdGroup: PGUID; cmdID: Cardinal): OLECMDF;
var
   CmdTarget: IOleCommandTarget;
   Cmd: TOleCmd;
begin
   Result := 0;
   if Supports(Document, IOleCommandTarget, CmdTarget) then
      begin
         Cmd.CmdID := cmdID;
         Cmd.cmdf := 0;
         if CmdTarget.QueryStatus(CmdGroup, 1, @Cmd, nil) = S_OK then
            Result := Cmd.cmdf;
      end;
end;

function TCustomEmbeddedWB.QueryCommandStatus(CmdGroup: PGUID; cCmds: Cardinal; prgCmds: POleCmd;
   CmdText: POleCmdText): HResult;
var
   CmdTarget: IOleCommandTarget;
begin
   if Supports(Document, IOleCommandTarget, CmdTarget) then
      Result := CmdTarget.QueryStatus(CmdGroup, cCmds, prgCmds, CmdText)
   else
      Result := E_UNEXPECTED;
end;

function TCustomEmbeddedWB.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
   Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HRESULT;
begin
   Result := S_FALSE;
   if (Flags and DISPATCH_PROPERTYGET <> 0) and (VarResult <> nil) then
      begin
         Result := S_OK;
         case DispID of
            DISPID_AMBIENT_DLCONTROL:
               PVariant(VarResult)^ := fDownloadOptionValue;
            DISPID_AMBIENT_USERMODE:
               if DesignMode then
                  POleVariant(VarResult)^ := False
               else
                  POleVariant(VarResult)^ := True;
            else
               Result := S_FALSE;
         end;
      end
   else
      if (Flags and DISPATCH_PROPERTYPUT <> 0) and
         (DispID = DISPID_AMBIENT_USERMODE) then
         begin
            Result := S_OK;
            Self.FDesignMode := POleVariant(TDispParams(Params).rgvarg)^;
         end;

   if Result = S_FALSE then
      begin
         Result := inherited Invoke(DispID, IID, LocaleID, Flags, Params,
            VarResult, ExcepInfo, ArgErr);
         if (result = DISP_E_MEMBERNOTFOUND) and Assigned(FOnInvoke) then
            FOnInvoke(DispID, IID, LocaleID, Flags, TagDispParams(Params),
               VarResult, ExcepInfo, ArgErr, Result);
      end;
end;

function TCustomEmbeddedWB.OnDocWindowActivate(const fActivate: BOOL): HRESULT;
begin
   if Assigned(FOnOnDocWindowActivate) then
      Result := FOnOnDocWindowActivate(FActivate)
   else
      Result := S_FALSE;
end;

function TCustomEmbeddedWB.OnFrameWindowActivate(const fActivate: BOOL): HRESULT;
begin
   if Assigned(FOnOnFrameWindowActivate) then
      Result := FOnOnFrameWindowActivate(fActivate)
   else
      Result := S_FALSE;
end;

procedure TCustomEmbeddedWB.DoQueryService(const rsid, iid: TGUID; out Obj);
begin
   if IsEqualGuid(rsid, IID_INewWindowManager) and
      Assigned(FOnEvaluateNewWindow) then
      IUnknown(Obj) := Self as INewWindowManager
   else
  { if IsEqualGuid(rsid, IID_IProtectFocus) then
         IUnknown(Obj) := Self as IProtectFocus
      else }
         if IsEqualGuid(rsid, IID_IDownloadManager) and
         Assigned(FOnDownload) then
            IUnknown(Obj) := Self as IDownloadManager
         else
            if IsEqualGuid(rsid, IID_IHTMLOMWindowServices) and
            (FloatingHosting or Assigned(FOnMove) or Assigned(Self.FOnMoveBy)
               or Assigned(FOnResize) or Assigned(FOnResizeBy)) then
               IUnknown(Obj) := Self as IHTMLOMWindowServices;
end;

function TCustomEmbeddedWB.QueryService(const rsid, iid: TGUID; out Obj): HRESULT;
begin
   Pointer(Obj) := nil;
   DoQueryService(rsid, iid, Obj);
   if Pointer(Obj) <> nil then
      Result := S_OK
   else
      if Assigned(FOnQueryService) then
         Result := FOnQueryService(rsid, iid, IUnknown(obj))
      else
         Result := E_NOINTERFACE;
end;

function TCustomEmbeddedWB.ResizeBorder(const prcBorder: PRECT;
   const pUIWindow: IOleInPlaceUIWindow; const FrameWindow: BOOL): HRESULT;
begin
   if Assigned(FOnResizeBorder) then
      Result := FOnResizeBorder(prcBorder, pUIWindow, FrameWindow)
   else
      Result := S_FALSE;
end;

procedure TCustomEmbeddedWB.MoveParentForm(x, y: Integer; Delta: Boolean);
var
   F: TCustomForm;
begin
   F := GetParentForm(Self);
   if F <> nil then
      begin
         if Delta then
            begin
               x := F.Left + x;
               y := F.Top + y;
            end; //FIXME defend from moving outside of screen  (don't forget multimonitor)
         F.SetBounds(x, y, F.Width, F.Height);
      end;
end;

procedure TCustomEmbeddedWB.ResizeParentForm(w, h: Integer; Delta: Boolean);
var
   F: TCustomForm;
begin
   F := GetParentForm(Self);
   if F <> nil then
      begin
         if Delta then
            begin
               w := F.Width + w;
               h := F.Height + h;
            end;
         F.SetBounds(F.Left, F.Top, w, h);
      end;
end;

function TCustomEmbeddedWB.resizeBy(const x, y: Integer): HRESULT;
begin
   if FloatingHosting then
      ResizeParentForm(x, y, True);
   if Assigned(FOnResizeBy) then
      FOnResizeBy(self, x, y);
   Result := S_OK; // always return success to prevent script error messages
end;

function TCustomEmbeddedWB.resizeTo(const x, y: Integer): HRESULT;
begin
   if FloatingHosting then
      ResizeParentForm(x, y, False);
   if Assigned(FOnResize) then
      FOnResize(self, x, y);
   Result := S_OK; // always return success to prevent script error messages
end;

function TCustomEmbeddedWB.moveBy(const x, y: Integer): HRESULT;
begin
   if FloatingHosting then
      MoveParentForm(x, y, True);
   if Assigned(FOnMoveBy) then
      FOnMoveBy(self, x, y);
   Result := S_OK; // always return success to prevent script error messages
end;

function TCustomEmbeddedWB.moveTo(const x, y: Integer): HRESULT;
begin
   if FloatingHosting then
      MoveParentForm(x, y, False);
   if Assigned(FOnMove) then
      FOnMove(self, x, y);
   Result := S_OK; // always return success to prevent script error messages
end;

function TCustomEmbeddedWB.OnZoomPercentChanged(const ulZoomPercent: uLong): HResult;
begin
  if Assigned(FOnZoomPercentChanged) then
     Result:= FOnZoomPercentChanged(ulZoomPercent)
  else
     Result := S_FALSE;
end;

procedure TCustomEmbeddedWB.UpdateDownloadControlValue;
const
   acardDownloadControlValues: array[TDownloadControlOption] of Cardinal =
   ($00000010, $00000020, $00000040, $00000080,
      $00000100, $00000200, $00000400, $00000800,
      $00001000, $00002000, $00004000, $00008000,
      $00010000, $00020000, $00040000, $10000000,
      $20000000, $40000000, $80000000);
var
   i: TDownloadControlOption;
begin
   FDownloadOptionValue := 0;
   if (FDownloadControlOptions <> []) then
      for i := Low(TDownloadControlOption) to High(TDownloadControlOption) do
         if (i in FDownloadControlOptions) then
            Inc(FDownloadOptionValue, acardDownloadControlValues[i]);
end;

function TCustomEmbeddedWB.GetElemByID(const ID: Widestring): IHTMLElement;
var
   Doc3: IHTMLDocument3;
begin
   if Supports(Document, IHTMLDocument3, Doc3) then
      Result := Doc3.getElementById(ID)
   else
      Result := nil;
end;

function TCustomEmbeddedWB.ScrollToElement(Element: IHTMLElement): Boolean;
var
   RV: IHTMLRect;
begin
   Result := Element <> nil;
   if Result then
      begin
         RV := (Element as IHTMLElement2).getBoundingClientRect;
         Doc2.parentWindow.scrollBy(RV.left, RV.top);
      end;
end;

function TCustomEmbeddedWB.GetCharSet: Widestring;
begin
   Result := Doc2.charset;
end;

procedure TCustomEmbeddedWB.SetCharSet(const Value: WideString);
var
   Level: OleVariant;
begin
   Doc2.charset := Value;
   Level := 7;
   DefaultInterface.Refresh2(Level);
end;

procedure TCustomEmbeddedWB.setDesignMode(const Value: Boolean);
var
   Control: IOleControl;
begin
   FDesignMode := Value;
   if DefaultInterface.QueryInterface(IOleControl, Control) = 0 then
      Control.OnAmbientPropertyChange(DISPID_AMBIENT_USERMODE);
end;

const
   _DesignModeValues: array[TDocDesignMode] of string =
   ('On', 'Off', 'Inherit', '');

function TCustomEmbeddedWB.getDocDesignMode: TDocDesignMode;
var
   D: IHTMLDocument2;
   I: Integer;
begin
   Result := ddmUnknown;
   if Supports(Document, IHTMLDocument2, D) then
      begin
         I := AnsiIndexStr(D.designMode, _DesignModeValues);
         if I in [0..2] then
            Result := TDocDesignMode(I);
      end;
end;

procedure TCustomEmbeddedWB.setDocDesignMode(const Value: TDocDesignMode);
var
   D: IHTMLDocument2;
begin
   if (Value <> ddmUnknown) and Supports(Document, IHTMLDocument2, D) then
      D.designMode := _DesignModeValues[Value];
end;

procedure TCustomEmbeddedWB.SetDownloadOptions(const Value: TDownloadControlOptions);
begin
   FDownloadControlOptions := Value;
   UpdateDownloadControlValue;
   (Application as IOleControl).OnAmbientPropertyChange(DISPID_AMBIENT_DLCONTROL);
end;

procedure TCustomEmbeddedWB.SetFocusToDoc;
begin
   if Document <> nil then
      with (Application as IOleobject) do
         DoVerb(OLEIVERB_UIACTIVATE, nil, Self, 0, Handle, GetClientRect);
end;

procedure TCustomEmbeddedWB.SetFocusToParent;
begin
   if IsWindow(WindowHandle) then
      begin
         Windows.SetParent(WindowHandle, TWinControl(Self).Parent.Handle);
         MoveWindow(WindowHandle, 0, 0, TWinControl(Self).Parent.Width,
            TWinControl(Self).Parent.Height, True);
         TWinControl(Self).Parent.SetFocus;
      end;
end;

procedure TCustomEmbeddedWB.SetUserInterfaceOptions(const Value: TUserInterfaceOptions);
begin
   FUserInterfaceOptions := Value;
   UpdateUserInterfaceValue;
   (Application as IOleControl).OnAmbientPropertyChange(DISPID_AMBIENT_DLCONTROL);
end;

procedure TCustomEmbeddedWB.SetDropHandlingType(const Value: TDragDropHandlingType);
var
   innerWnd: LongWord;
   Impl: IDropTarget;
begin
   if FDropHandlingType <> Value then
      begin
         FDropHandlingType := Value;

         if HandleAllocated then
            innerWnd := GetIEWin('Internet Explorer_Server')
         else
            innerWnd := 0;
         if innerWnd <> 0 then
            RevokeDragDrop(innerWnd);

         Impl := nil;
         case Value of
            ddtMS:
               DefaultInterface.RegisterAsDropTarget := True;
            ddtMy: Impl := Self;
            ddtCustom:
               if innerWnd <> 0 then
                  begin
                     Impl := Self;
                     if Assigned(FOnGetDropTarget) then
                        FOnGetDropTarget(Impl);
                  end;
            ddtNo:
               DefaultInterface.RegisterAsDropTarget := False;
         end;
         if (innerWnd <> 0) and (Impl <> nil) then
            RegisterDragDrop(innerWnd, Impl);
      end;
end;

function TCustomEmbeddedWB.GetDropTarget(const pDropTarget: IDropTarget;
   out ppDropTarget: IDropTarget): HRESULT;
begin
   Result := S_OK;
   case DropHandlingType of
      ddtMS:
         begin
            DefaultInterface.RegisterAsDropTarget := True;
            Result := E_NOTIMPL;
         end;
      ddtMy:
         ppDropTarget := Self;
      ddtCustom:
         begin
            ppDropTarget := Self;
            if Assigned(FOnGetDropTarget) then
               FOnGetDropTarget(ppDropTarget);
         end;
      ddtNo:
         begin
            DefaultInterface.RegisterAsDropTarget := False;
            ppDropTarget := nil;
         end;
   end;
end;

function TCustomEmbeddedWB.DragEnter(const dataObj: IDataObject; grfKeyState: Integer;
   pt: TPoint; var dwEffect: Integer): HResult;
begin
   if Assigned(OnDragEnter) then
      Result := OnDragEnter(dataObj, grfKeyState, pt, dwEffect
{$IFDEF OLDVERSION_COMPATIBLE}
         , dwEffectToStr(dwEffect)
{$ENDIF})
   else
      Result := NOERROR;
end;

function TCustomEmbeddedWB.DragLeave: HResult;
begin
   if Assigned(OnDragLeave) then
      Result := OnDragLeave
   else
      Result := NOERROR;
end;

function TCustomEmbeddedWB.Drop(const dataObj: IDataObject; grfKeyState: Integer;
   pt: TPoint; var dwEffect: Integer): HResult;
begin
   if Assigned(FOnDropEvent) then
      Result := FOnDropEvent(dataObj, grfKeyState,
{$IFDEF OLDVERSION_COMPATIBLE}
         Self.ClientToScreen(pt), dwEffect, dwEffectToStr(dwEffect)
{$ELSE}
         pt, dwEffect
{$ENDIF})
   else
      Result := NOERROR;
end;

function TCustomEmbeddedWB.DropTargetDragOver(grfKeyState: Integer; pt: TPoint;
   var dwEffect: Integer): HResult;
begin
   if Assigned(FOnDragOverEvent) then
      Result := FOnDragOverEvent(grfKeyState,
{$IFDEF OLDVERSION_COMPATIBLE}
         Self.ClientToScreen(pt), dwEffect, dwEffectToStr(dwEffect)
{$ELSE}
         pt, dwEffect
{$ENDIF})
   else
      Result := NOERROR;
end;

function TCustomEmbeddedWB.Download(pmk: IMoniker; pbc: IBindCtx; dwBindVerb,
   grfBINDF: DWORD; pBindInfo: PBindInfo; pszHeaders, pszRedir: PWidechar;
   uiCP: UINT): HRESULT;
begin
   if Assigned(FOnDownload) then
      Result := FOnDownload(pmk, pbc, dwBindVerb, grfBINDF, pBindInfo, pszHeaders,
         pszRedir, uiCP)
   else
      Result := E_NOTIMPL;
end;

function TCustomEmbeddedWB.FilterPopupMenu: Boolean;
begin
   Result := Assigned(OnFilterPopupMenu);
end;

procedure TCustomEmbeddedWB.DoFilterPopupMenu(ID: DWORD; Menu: HMENU; const Context: IDispatch);
begin
   if Assigned(OnFilterPopupMenu) then
      OnFilterPopupMenu(ID, Menu, Context);
end;

function TCustomEmbeddedWB.ShowContextMenu(const dwID: DWORD; const ppt: PPOINT;
   const pcmdtReserved: IUnknown; const pdispReserved: IDispatch): HRESULT;
var
   EncodingSubMenu: OleVariant;
begin
   if Assigned(FOnShowContextMenu) then
      Result := FOnShowContextMenu(dwID, ppt, pcmdtReserved, pdispReserved)
   else
      if IsSeTIEPopupMenus(dwID, DisabledPopupMenus) then
         Result := S_OK
      else
         if FilterPopupMenu then
            begin
               ExecWB(CGetMimeSubMenuCommandID, OLECMDEXECOPT_DODEFAULT, EncodingSubMenu);
               if ShowRightClickMenu(dwID, pcmdtReserved, pdispReserved, ppt, EncodingSubMenu, DoFilterPopupMenu) then
                  Result := S_OK
               else
                  Result := S_FALSE;
            end
         else
            Result := S_FALSE;
end;

function TCustomEmbeddedWB.ShowHelp(HWND: THandle; pszHelpFile: POleStr; uCommand,
   dwData: Integer; ptMouse: TPoint; var pDispatchObjectHit: IDispatch): HRESULT;
begin
   if Assigned(FOnShowHelp) then
      Result := FOnShowHelp(HWND, pszHelpFile, uCommand, dwData, ptMouse, pDispatchObjectHit)
   else
      if (pszHelpFile = nil) and (HelpFile <> '') then
         begin
            HtmlHelp(HWND, PChar(HelpFile), uCommand, dwData);
            Result := S_OK;
         end
      else
         Result := S_FALSE;
end;

function TCustomEmbeddedWB.ShowMessage(HWND: THandle; lpstrText, lpstrCaption: POleStr;
   dwType: Integer; lpstrHelpFile: POleStr; dwHelpContext: Integer;
   var plResult: LRESULT): HRESULT;
begin
   if Assigned(FOnShowMessage) then
      Result := FOnShowMessage(HWND, lpstrText, lpStrCaption, dwType, lpStrHelpFile, dwHelpContext, plResult)
   else
      Result := S_FALSE;
end;

function TCustomEmbeddedWB.ShowUI(const dwID: DWORD;
   const pActiveObject: IOleInPlaceActiveObject;
   const pCommandTarget: IOleCommandTarget; const pFrame: IOleInPlaceFrame;
   const pDoc: IOleInPlaceUIWindow): HRESULT;
begin
   if Assigned(FOnShowUI) then
      Result := FOnShowUI(dwID, pActiveObject, pCommandTarget, pFrame, pDoc)
   else
      Result := S_FALSE;
end;

function _CharPos(const C: Char; const S: string): Integer;
begin
   for Result := 1 to Length(S) do
      if S[Result] = C then
         Exit;
   Result := 0;
end;

function TCustomEmbeddedWB.DoFilterMsg(const lpMsg: PMSG): HRESULT;
var
   I: Integer;
begin
   Result := S_FALSE;
   if (CtrlCharMask <> '') and (lpMsg^.message = WM_KEYDOWN)
      and (GetKeyState(VK_CONTROL) < 0) then
      begin
         I := _CharPos(Char(lpMsg.wParam), CtrlCharMask);
         if I > 0 then
            begin
               Result := S_OK;
               if Assigned(OnMaskedCtrlChar) then
                  OnMaskedCtrlChar(Self, Char(lpMsg.wParam));
            end;
      end;
end;

function TCustomEmbeddedWB.TranslateAccelerator(const lpMsg: PMSG;
   const pguidCmdGroup: PGUID; const nCmdID: DWORD): HRESULT;
begin
   Result := DoFilterMsg(lpMsg);
   if (Result = S_FALSE) and Assigned(FOnTranslateAccelerator) then
      Result := FOnTranslateAccelerator(lpMsg, pguidCmdGroup, nCmdID);
end;

function TCustomEmbeddedWB.TranslateUrl(const dwTranslate: DWORD; const pchURLIn: POLESTR;
      out ppchURLOut: POLESTR): HRESULT;
begin
   if Assigned(FOnTranslateUrl) then
      Result := FOnTranslateUrl(dwTranslate, pchUrlIn, ppchUrlOut)
   else
      Result := S_FALSE;
end;

function TCustomEmbeddedWB.UpdateUI: HRESULT;
begin
   if Assigned(FOnUpdateUI) then
      Result := FOnUpdateUI
   else
      Result := S_FALSE;
end;

procedure TCustomEmbeddedWB.UpdateUserInterfaceValue;
const
   acardUserInterfaceValues: array[TUserInterfaceOption] of Cardinal =
   ($00000001, $00000002, $00000004, $00000008,
      $00000010, $00000020, $00000040, $00000080,
      $00000100, $00000200, $00000400, $00000800,
      $00001000, $00002000, $00004000, $00010000, $00020000,
      $00040000, $00080000, $00100000, $00200000, $00400000,
      $00800000, $01000000, $02000000, $04000000, $08000000,
      $10000000, $20000000);
var
   i: TUserInterfaceOption;
begin
   FUserInterfaceValue := 0;
   if (FUserInterfaceOptions <> []) then
      for i := Low(TUserInterfaceOption) to High(TUserInterfaceOption) do
         if (i in FUserInterfaceOptions) then
            Inc(FUserInterfaceValue, acardUserInterfaceValues[i]);
end;

function TCustomEmbeddedWB._getCookie: Widestring;
begin
   Result := OleObject.Document.Cookie;
end;

procedure TCustomEmbeddedWB.Client2HostWin(var CX, CY: Integer);
var
   F: TCustomForm;
begin
   F := GetParentForm(Self);
   if F <> nil then
      begin
         Inc(CX, F.ClientWidth - Self.Width);
         Inc(CY, F.ClientHeight - Self.Height);
      end;
end;

{$IFDEF USE_IOLECOMMANDTARGET}
//======IOleCommandTarget interface ============================================

function TCustomEmbeddedWB.CommandTarget_QueryStatus(CmdGroup: PGUID; cCmds: Cardinal;
   prgCmds: POleCmd; CmdText: POleCmdText): HResult;
begin
   Result := S_OK;
end;

function TCustomEmbeddedWB.CommandTarget_Exec(CmdGroup: PGUID; nCmdID, nCmdexecopt: DWORD;
   const vaIn: OleVariant; var vaOut: OleVariant): HResult;
var
   tmpCancel: Boolean;
begin
   Result := OLECMDERR_E_NOTSUPPORTED;
   if CmdGroup <> nil then
      begin
         if IsEqualGuid(cmdGroup^, CGID_EXPLORER) and
            (ncmdID = OLECMDID_ONUNLOAD) and
            Assigned(FOnUnload) then
            begin
               FOnUnload(Self);
               Result := S_OK;
               Exit;
            end;

         if IsEqualGuid(cmdGroup^, CGID_DocHostCommandHandler) then
            case nCmdID of
               6041 {F5},
                  6042 {ContextMenu},
                  2300:
                  begin
                     if Assigned(FOnRefresh) then
                        begin
                           tmpCancel := False;
                           FOnRefresh(Self, nCmdID, tmpCancel);
                           if tmpCancel then
                              Result := S_OK; //FIXME is it true? Why not OLECMDERR_E_CANCELED
                        end;
                     Exit;
                  end;
               OLECMDID_SHOWSCRIPTERROR:
                  begin
                     Result := ScriptErrorHandler(vaIn, vaOut);
                     Exit;
                  end;
            end;
      end;
   if Assigned(OnCommandExec) then
      Self.OnCommandExec(CmdGroup, nCmdID, nCmdexecopt,
         vaIn, vaOut, Result);
end;
{$ENDIF}

function TCustomEmbeddedWB.ScriptErrorHandler(const vaIn: OleVariant;
   var vaOut: OleVariant): HRESULT;
var
   EventObject: IHTMLEventObj;
   CurWindow: IHTMLWindow2;
   CurDocument: IHTMLDocument2;
   CurUnknown: IUnknown;
  function GetProperty(const PropName: WideString): OleVariant;
   var
      DispParams: TDispParams;
      Disp, Status: Integer;
      ExcepInfo: TExcepInfo;
      PPropName: PWideChar;
   begin
      DispParams.rgvarg := nil;
      DispParams.rgdispidNamedArgs := nil;
      DispParams.cArgs := 0;
      DispParams.cNamedArgs := 0;
      PPropName := PWideChar(PropName);
      Status := EventObject.GetIDsOfNames(GUID_NULL, @PPropName, 1, LOCALE_SYSTEM_DEFAULT, @Disp);
      if Status = 0 then
         begin
            Status := EventObject.Invoke(disp, GUID_NULL, LOCALE_SYSTEM_DEFAULT,
               DISPATCH_PROPERTYGET, DispParams, @Result, @ExcepInfo, nil);
            if Status <> 0 then
               DispatchInvokeError(Status, ExcepInfo);
         end
      else
         if Status = DISP_E_UNKNOWNNAME then
            raise
               EOleError.CreateFmt('''%s'' not supported.', [PropName])
         else
            OleCheck(Status);
   end;
begin
   Result := S_OK;
   case FScriptErrorAction of
        eaAskUser : Result := S_FALSE;//E_FAIL;
        eaContinue: vaOut := True;
        eaCancel  : vaOut := False;
   end;

   if Assigned(FOnScriptError) then
      begin
         CurUnknown := IUnknown(TVarData(vaIn).VUnknown);
         if Succeeded(CurUnknown.QueryInterface(IID_IHTMLDocument2, CurDocument)) then
            begin
               CurWindow := CurDocument.Get_parentWindow;
               CurDocument := nil;
               if Assigned(CurWindow) then
                  begin
                     EventObject := CurWindow.Get_event;
                     if EventObject <> nil then
                        begin
                           FOnScriptError(Self,
                              GetProperty('errorline'),
                              GetProperty('errorCharacter'),
                              GetProperty('errorCode'),
                              GetProperty('errorMessage'),
                              GetProperty('errorUrl'),
                              FScriptErrorAction);
                        end;
                  end;
            end;
      end;
end;

{ TEwbCore }

function TEwbCore.IsCtrlCharMask: Boolean;
begin
   Result := CtrlCharMask <> 'N';
end;


end.


